home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / Anwendun / IGING / IGINGMUL.LST < prev    next >
Encoding:
File List  |  2000-05-01  |  32.7 KB  |  1,505 lines
  1. REM IGINGMUL 3.3.2   GFA 3.6    1.5.0 ogg
  2. REM
  3. REM DAS ELEKTRONISCHE I GING
  4. REM (C) Copyleft  1/0,5/0  Zwyrd
  5. REM
  6. REM This program is free software; you can redistribute it and/or
  7. REM modify it under the terms of the GNU General Public License
  8. REM as published by the Free Software Foundation; either version 2
  9. REM of the License, or (at your option) any later version.
  10. REM This program is distributed in the hope that it will be useful,
  11. REM but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. REM MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. REM GNU General Public License for more details.
  14. REM You should have received a copy of the GNU General Public License
  15. REM along with this program; if not, write to the Free Software
  16. REM Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  17. REM Read READ_ME.TXT and I_GINGTT.TXT for information about the Programm
  18. REM and GPL.TXT and GPL_DE.TXT for information about the GPL.
  19. '
  20. $m44006                         !compileroption programmspeicher
  21. basep$=SPACE$(128)
  22. BMOVE BASEPAGE+128,V:basep$,128            !EVENTUELLE PARAMETER SICHERN
  23. '
  24. DEFWRD "a-z"              !ALLE VARIABLEN OHNE POSTFIX 2BYTE INTEGER
  25. '                         !ALLE EINBUCHSTABIGEN WERTE-VARIABLEN SIND LOKAL
  26. ap_id=APPL_INIT()
  27. igg$="  I Ging"
  28. IF @t<>0                             !wenn multitasking
  29.   ~MENU_REGISTER(ap_id,igg$)         !dann anmelden
  30.   ~SHEL_WRITE(9,1,0,CHR$(0),CHR$(0))
  31. ENDIF
  32. INTIN(0)=1                    !FARBTIEFE ABFRAGEN
  33. VDISYS 102,1,0
  34. bitpl=INTOUT(4)
  35. scr_br=WORK_OUT(0)            !BILDSCHIRMGRÖßE
  36. scr_ho=WORK_OUT(1)
  37. '
  38. IF @c<>0                                       !wenn compiliert
  39.   pfad$=CHR$(GEMDOS(25)+65)+":"+DIR$(0)+"\"    !dann pfad feststellen
  40. ELSE
  41.   RESERVE (44006)
  42.   pfad$="E:\KAOS\IGING\"                   !im Editor hier eigenen Pfad
  43. ENDIF
  44. '
  45. IF XBIOS(44,-1)=44 OR GEMDOS(68,L:-1,1)<0       !ST/STE
  46.   a_st=1
  47. ENDIF
  48. IF @fre<150000
  49.   ~FORM_ALERT(1,"[3][NICHT GENUG|SPEICHER|NO MEMORY][ OK ]")
  50.   END
  51. ENDIF
  52. j$=pfad$+"IGINGSTR.DAT"
  53. IF EXIST(j$)=0
  54.   ~FORM_ALERT(1,"[2][ IGINGSTR.DAT? ][ GRUMPH ]")
  55.   END
  56. ENDIF
  57. h$=SPACE$(2300)
  58. oget(j$,V:h$)
  59. IF RSRC_LOAD(pfad$+"IGING.RSC")=0
  60.   ~FORM_ALERT(1,"[2][ IGING.RSC? ][ GRUMPH ]")
  61.   END
  62. ENDIF
  63. ~RSRC_GADDR(0,0,men_1%)                  !RESOURCE-ADRESSEN
  64. ~RSRC_GADDR(0,1,men_2%)
  65. ~RSRC_GADDR(0,2,ver_1%)
  66. ~RSRC_GADDR(0,3,ver_2%)
  67. ~RSRC_GADDR(0,4,end_1%)
  68. ~RSRC_GADDR(0,5,end_2%)
  69. '
  70. DIM wind(9),t(6),a(7),line(14),logli(5),t$(60),r$(60),l$(10),co(15)
  71. '    WIND()   =FENSTERANGABEN
  72. '    T()      =INFOSEITEN
  73. '    A()      =EVENT-BUFFER
  74. '    LINE()   =IGING-LINIEN
  75. '    LOGLI()  =IGING-LINIEN
  76. '    T$()     =AKTUELLER SATZ STRINGS
  77. '    R$()     =2.SATZ STRINGS
  78. '    L$()     =TEXTDATEI-NAMEN
  79. '    CO()     =FARBKANAL-BUFFER
  80. '
  81. qui=0
  82. laden                           !TEXTE LADEN
  83. IF qui<>0
  84.   ~FORM_ALERT(1,"[2]["+canc$+"][ GRUMPH ]")
  85.   ~RSRC_FREE()
  86.   CLEAR
  87.   END
  88. ENDIF
  89. '
  90. vars                          !PROGRAMM EINRICHTEN
  91. '
  92. ON ERROR GOSUB f
  93. ON BREAK GOSUB ade
  94. '
  95. f:
  96. main
  97. '
  98. CLEAR
  99. END
  100. '
  101. DEFFN t=INT{ADD({ADD(GB,4)},2)}<>1        !MULTITOS?
  102. DEFFN c=BYTE{ADD(BASEPAGE,256)}<>96       !COMPILIERT?
  103. DEFFN b=scr_br-@offs_x+1                  !BILDSCHIRMRAND
  104. DEFFN h=scr_ho-@offs_y+1
  105. DEFFN offs_x=wind(0)+1                    !OFFSET ARBEITSBEREICH
  106. DEFFN offs_y=wind(1)+wi_ti
  107. '
  108. ' FENSTER-ANGABEN
  109. DATA 0,19,640,440,300,20,5,0,72,72
  110. '
  111. ' MISCHFARBEN
  112. DATA 3549,2457,11,176,2816,2992,187
  113. '
  114. t:        !KOORDINATEN FÜR MINI-TRIGRAMME
  115. DATA 0,5,10,32,37,64,96,106,42,69,74,101
  116. DATA 42,69,74,101,0,5,10,32,37,64,96,106
  117. '
  118. m:        !DIE HEXAGRAMME ALS LOGARITHMEN
  119. DATA 63,4032,2961,1890,2583,378,3906,3024
  120. DATA 567,315,3591,504,189,1071,3780,3528
  121. DATA 2457,1638,3843,1008,1449,1701,2016,3969
  122. DATA 441,1575,1953,2142,2898,1197,2268,3150
  123. DATA 252,3087,1512,3717,693,1323,2772,3402
  124. DATA 1827,945,2079,126,2520,3654,2394,2646
  125. DATA 2205,1134,3465,1764,756,3339,3213,1260
  126. DATA 630,2331,882,2835,819,3276,2709,1386
  127. '
  128. '            DIE START-PROZEDUREN
  129. > PROCEDURE laden
  130.   w=1
  131.   inr(0,1)
  132.   inr(1,11)
  133.   inr(2,11)
  134.   v=INSTR(w,h$,CHR$(13))
  135.   logo=MAX(0,MIN(1,VAL(MID$(h$,w,v-w-1))))
  136.   w=v+2
  137.   v=INSTR(w,h$,CHR$(13))
  138.   orakel=MAX(1,MIN(4,VAL(MID$(h$,w,v-w-1))))
  139.   w=v+2
  140.   v=INSTR(w,h$,CHR$(13))
  141.   menlan=MAX(0,MIN(1,VAL(MID$(h$,w,v-w-1))))
  142.   w=v+2
  143.   v=INSTR(w,h$,CHR$(13))
  144.   back=MAX(0,MIN(1,VAL(MID$(h$,w,v-w-1))))
  145.   IF INSTR(basep$,"-tao")>0 OR INSTR(basep$,"-TAO")>0
  146.     autao=1
  147.   ENDIF
  148.   IF INSTR(basep$,"-ig")>0 OR INSTR(basep$,"-IG")>0
  149.     auigg=1
  150.   ENDIF
  151.   IF INSTR(basep$,"-ex")>0 OR INSTR(basep$,"-EX")>0
  152.     IF autao=1
  153.       autao_ex=1
  154.     ELSE IF auigg=1
  155.       auigg_ex=1
  156.     ENDIF
  157.   ENDIF
  158.   IF autao_ex=0
  159.     i$=pfad$+l$(0)         !URTEILE + LINIEN  1.SATZ
  160.     c$=pfad$+l$(1)
  161.     t$=pfad$+l$(2)
  162.     FOR f=0 TO 2
  163.       IF EXIST(pfad$+l$(f))=0
  164.         canc$=l$(f)
  165.         qui=1
  166.       ENDIF
  167.     NEXT f
  168.     IF qui=0
  169.       urt1%=@mal(32000)
  170.       lin1%=@mal(64000)
  171.       oget(i$,urt1%)
  172.       oget(c$,lin1%)
  173.       oget(t$,lin1%+32000)
  174.     ENDIF
  175.   ENDIF
  176.   CLR h$
  177.   texte$=SPACE$(32000)
  178.   IF auigg_ex=0 AND qui=0 AND l$(5)<>"" AND l$(6)<>""
  179.     t$=pfad$+l$(5)                !TAO-DATEIEN
  180.     c$=pfad$+l$(6)
  181.     IF EXIST(t$)=0 OR EXIST(c$)=0 OR @fre<120000
  182.       IF autao_ex=1
  183.         canc$=t$+"?|"+c$+"?"
  184.         qui=1
  185.       ENDIF
  186.       nixtao=1
  187.     ELSE
  188.       tao%=@mal(64000)
  189.       oget(t$,tao%)
  190.       oget(c$,tao%+32000)
  191.     ENDIF
  192.   ELSE
  193.     nixtao=1
  194.   ENDIF
  195.   IF autao_ex=0 AND auigg_ex=0 AND qui=0
  196.     IF l$(4)<>""
  197.       i$=pfad$+l$(4)                     !INFO-DATEI
  198.       IF EXIST(i$)=0 OR @fre<70000
  199.         nixinfo=1
  200.       ELSE
  201.         inf%=@mal(12000)
  202.         oget(i$,inf%)
  203.         ~EVNT_TIMER(230)
  204.         bmov(inf%,12)           !INFO-SEITENANFANG ERMITTELN
  205.         t(0)=1
  206.         FOR f=1 TO 6
  207.           t(f)=INSTR(texte$,"*"+STR$(f))
  208.         NEXT f
  209.       ENDIF
  210.     ELSE
  211.       nixinfo=1
  212.     ENDIF
  213.     IF l$(3)<>""
  214.       c$=pfad$+l$(3)                 !URTEILE 2.SATZ
  215.       IF EXIST(c$)=0 OR @fre<90000
  216.         nixtxt2=1
  217.       ELSE
  218.         urt2%=@mal(32000)
  219.         oget(c$,urt2%)
  220.       ENDIF
  221.     ELSE
  222.       nixtxt2=1
  223.     ENDIF
  224.     IF l$(7)<>"" AND l$(8)<>""
  225.       i$=pfad$+l$(7)               !LINIEN 2.SATZ
  226.       c$=pfad$+l$(8)
  227.       IF EXIST(c$)=0 OR EXIST(i$)=0 OR @fre<120000
  228.         nixlin2=1
  229.       ELSE
  230.         lin2%=@mal(64000)
  231.         oget(i$,lin2%)
  232.         oget(c$,lin2%+32000)
  233.       ENDIF
  234.     ELSE
  235.       nixlin2=1
  236.     ENDIF
  237.     i$=pfad$+"GPL.TXT"
  238.     c$=pfad$+"GPL_DE.TXT"
  239.     IF EXIST(c$)=0 OR EXIST(i$)=0 OR @fre<110000
  240.       nixgpl=1
  241.     ELSE
  242.       gpl_de%=@mal(26000)       !GPL-DATEIEN
  243.       gpl_en%=@mal(26000)
  244.       oget(i$,gpl_en%)
  245.       oget(c$,gpl_de%)
  246.     ENDIF
  247.   ENDIF
  248. RETURN
  249. > PROCEDURE oget(nam$,o%)  !FILE LADEN
  250.   OPEN "I",#1,nam$
  251.   BGET #1,o%,LOF(#1)
  252.   CLOSE #1
  253. RETURN
  254. > PROCEDURE inr(r,s)       !STRINGS AUS IGINGSTR.DAT LESEN
  255.   FOR f=0 TO s
  256.     FOR i=0 TO 4
  257.       v=INSTR(w,h$,CHR$(44))
  258.       j=f*5+i
  259.       IF r=0
  260.         l$(j)=MID$(h$,w,v-w)
  261.         IF j>2 AND LEFT$(l$(j),1)="-"
  262.           l$(j)=""
  263.         ENDIF
  264.       ELSE IF r=1
  265.         t$(j)=MID$(h$,w,v-w)
  266.       ELSE
  267.         r$(j)=MID$(h$,w,v-w)
  268.       ENDIF
  269.       w=v+1
  270.     NEXT i
  271.     ADD w,2
  272.   NEXT f
  273.   ADD w,2
  274. RETURN
  275. > PROCEDURE vars           !VARIABLEN,MENU INITIALISIEREN
  276.   evnt_ad%=V:a(0)           !EVENT-BUFFER
  277.   ABSOLUTE m1,evnt_ad%         !EVENT-VARIABLEN
  278.   ABSOLUTE m4,evnt_ad%+6
  279.   ABSOLUTE m5,evnt_ad%+8
  280.   ABSOLUTE m6,evnt_ad%+10
  281.   ABSOLUTE m7,evnt_ad%+12
  282.   ABSOLUTE m8,evnt_ad%+14
  283.   '                          MINI-YINYANG IM ICONFENSTER
  284.   yiya$=MKI$(61471)+MKI$(57583)+MKI$(49655)+MKI$(33787)+MKI$(925)+MKI$(925)+MKI$(509)+MKI$(254)+MKI$(125)+MKI$(3133)+MKI$(3133)+MKI$(32827)+MKI$(49271)+MKI$(57583)+MKI$(61471)+MKI$(65279)
  285.   '
  286.   CLR wi_ti,mini,icon,task,l%,act_ev,again,e_gp,info,sgpl
  287.   CLR wanco,wand7,icount,auex,linco,hex_y,hex,nam$,nam1$,key,mcl,oco
  288.   '
  289.   urteil%=urt1%
  290.   line%=lin1%
  291.   text2=34
  292.   tao=1
  293.   men_h=19             !MENÜHÖHE
  294.   ~VQT_EXTENT(igg$,fx,fy,fv,fw,bx,by,bv,bw)
  295.   IF by-fy<10 AND (bitpl=4 OR bitpl=2)
  296.     men_h=11
  297.   ENDIF
  298.   FOR f=0 TO 9
  299.     READ wind(f)
  300.   NEXT f
  301.   wind(1)=men_h
  302.   wind(7)=scr_ho-140
  303.   scr_co=0
  304.   txt_co=1
  305.   FOR f=2 TO 15
  306.     co(f)=f
  307.   NEXT f
  308.   FOR f=8 TO 14
  309.     READ c
  310.     VSETCOLOR f,c
  311.   NEXT f
  312.   IF back=1
  313.     SWAP co(8),co(9)
  314.   ENDIF
  315.   ~GRAF_MOUSE(0,0)
  316.   start=1
  317.   mncha(0)                 !MENÜ EINRICHTEN
  318.   w1=WIND_CREATE(&X100000000001111,scr_br,scr_ho,wind(2),wind(3))
  319.   w2=WIND_CREATE(&X1001,scr_br,scr_ho,140,140)
  320.   awin=w1
  321.   opwin             !FENSTER ÖFFNEN
  322.   start=0
  323.   INTIN(0)=0        !TEXTAUSGABE LINKS OBEN => TEXT 0,0 = PRINT AT(1,1)
  324.   INTIN(1)=5            !  "
  325.   VDISYS 39,2,0         !  "
  326.   IF autao=1
  327.     IF nixtao=0
  328.       taoor
  329.       autao=0
  330.     ENDIF
  331.   ELSE IF auigg=1
  332.     task=2
  333.     icount=-1
  334.   ENDIF
  335. RETURN
  336. '
  337. '            DIE HAUPT-PROZEDUREN
  338. > PROCEDURE main
  339.   REPEAT
  340.     l%=FRE(0)
  341.     ~EVNT_TIMER(230)
  342.     act_ev=EVNT_MULTI(&X10011,2,1,1,0,0,0,0,0,0,0,0,0,0,evnt_ad%,0,x,y,ke,w,key,mcl)
  343.     IF auex=1
  344.       ade
  345.     ENDIF
  346.     IF qui=0
  347.       IF BTST(act_ev,0)<>0                  !TASTATUREINGABE
  348.         keyboard
  349.       ENDIF
  350.       IF BTST(act_ev,1)<>0 AND mini=0        !MAUSEVENT
  351.         button
  352.       ENDIF
  353.       IF BTST(act_ev,4)<>0             !FENSTER- UND MENÜEVENTS
  354.         SELECT m1
  355.         CASE 10
  356.           menu
  357.         CASE 20
  358.           red(m5,m6,m7,m8,2)              !EVENT-REDRAW
  359.         CASE 21
  360.           ~WIND_SET(awin,10,awin,0,0,0)     !FENSTER TOPPEN
  361.         CASE 22
  362.           ade                          !ENDE
  363.         CASE 23
  364.           mima                      !FULLER => BALKEN
  365.         CASE 28
  366.           wind(0)=m5                !FENSTER BEWEGEN
  367.           wind(1)=m6
  368.           wmov
  369.         CASE 34                        !ICONIFIER
  370.           icon(34)
  371.         CASE 50                    !SIG_TERM,SIG_KILL?
  372.           auex=1
  373.           ade
  374.         ENDSELECT
  375.       ENDIF
  376.     ENDIF
  377.   UNTIL qui<>0
  378. RETURN
  379. > PROCEDURE keyboard       !TASTATUR-EREIGNISSE
  380.   ascii=BYTE(key)
  381.   SELECT key
  382.   CASE &H3002            !^b
  383.     mima
  384.   CASE &H1011             !^q
  385.     ade
  386.   CASE &H1117         !^w
  387.     mncha(1)
  388.   CASE &H2308          !^h
  389.     chaco
  390.   CASE &H1709           !^i
  391.     icon(0)
  392.   DEFAULT
  393.     IF mini=0 AND icon=0
  394.       SELECT key
  395.       CASE &H2F76,&H2F56     !V
  396.         form(rsc_ve%)
  397.       CASE &H1F73,&H1F53        !S
  398.         task=1
  399.         bmov(urteil%,32)
  400.         red_ne(0)
  401.       CASE &H1372,&H1352       !R
  402.         IF again=1
  403.           as(3)
  404.         ENDIF
  405.       CASE &H1769,&H1749        !I
  406.         IF nixinfo=0
  407.           infin
  408.         ENDIF
  409.       CASE &H1474,&H1454     !T
  410.         IF nixtao=0
  411.           tao
  412.         ENDIF
  413.       CASE &H1E61,&H1E41    !A
  414.         IF nixtao=0
  415.           taoor
  416.         ENDIF
  417.       CASE &H1177,&H1157,&H157A,&H155A  !W,Z
  418.         IF task>3
  419.           inp_txt(ascii MOD 32 DIV 26)
  420.         ENDIF
  421.       CASE &H4800,&H5000          !UP,DOWN
  422.         IF task>3
  423.           inp_txt(-((key/&H100-&H48)/8)+1)
  424.         ENDIF
  425.       CASE &H2267,&H2247,&H6939,&HA39,&H1C0D,&H720D    !G,9,RET
  426.         IF task=2 OR task=3
  427.           go
  428.         ENDIF
  429.       CASE &H6B35,&H635,&H246A,&H244A,&H2C79,&H2C59     !J,Y,5
  430.         IF task<>2
  431.           ARRAYFILL line(),0
  432.           ARRAYFILL logli(),0
  433.           as(2)
  434.         ENDIF
  435.       CASE &H326D,&H324D,&H316E,&H314E,&H186F,&H184F,&H1970,&H1950  !M,N,O,P
  436.         orcha(ascii MOD 32+23)
  437.       CASE &H6D31,&H6E32,&H231,&H332      !1,2
  438.         IF nixtxt2=0
  439.           txcha(ascii-16)
  440.         ENDIF
  441.       CASE &H2207       !^G
  442.         IF nixgpl=0
  443.           gplin
  444.         ENDIF
  445.       CASE &H250B        !^K
  446.         kan
  447.       CASE &H260C            !^L
  448.         logch
  449.       CASE &H1F13          !^S
  450.         osave
  451.       CASE &H7700          !^CLRH
  452.         red_ne(2)
  453.       ENDSELECT
  454.     ENDIF
  455.   ENDSELECT
  456. RETURN
  457. > PROCEDURE button         !MAUS-EREIGNISSE
  458.   SUB x,@offs_x
  459.   SUB y,@offs_y
  460.   IF icon=1
  461.     IF x>0 AND x<72 AND y>0 AND y<52 AND mcl=2
  462.       icon(1)
  463.     ENDIF
  464.   ELSE
  465.     IF task=2 OR task=3
  466.       go
  467.     ELSE IF task>3
  468.       IF y>0 AND y<419 AND x>0 AND x<637
  469.         inp_txt(-(x DIV 320)+1)
  470.       ENDIF
  471.     ENDIF
  472.   ENDIF
  473. RETURN
  474. > PROCEDURE menu           !MENUE-EREIGNISSE
  475.   ~MENU_TNORMAL(rsc_me%,m4,1)
  476.   SELECT m5
  477.   CASE 25
  478.     ade
  479.   CASE 41
  480.     mima
  481.   CASE 42
  482.     icon(0)
  483.   CASE 44
  484.     mncha(1)
  485.   CASE 45
  486.     chaco
  487.   DEFAULT
  488.     IF mini=0 AND icon=0
  489.       SELECT m5
  490.       CASE 11
  491.         form(rsc_ve%)
  492.       CASE 20
  493.         task=1
  494.         bmov(urteil%,32)
  495.         red_ne(0)
  496.       CASE 21
  497.         as(3)
  498.       CASE 23
  499.         osave
  500.       CASE 27
  501.         infin
  502.       CASE 28
  503.         gplin
  504.       CASE 30
  505.         tao
  506.       CASE 31
  507.         taoor
  508.       CASE 33,34
  509.         txcha(m5)
  510.       CASE 36,37,38,39
  511.         orcha(m5)
  512.       CASE 46
  513.         kan
  514.       CASE 47
  515.         logch
  516.       ENDSELECT
  517.     ENDIF
  518.   ENDSELECT
  519. RETURN
  520. '
  521. '            SYSTEM-PROZEDUREN
  522. > PROCEDURE ade            !ENDE
  523.   IF auex=0
  524.     form(rsc_en%)
  525.   ENDIF
  526.   IF ro=2 OR auex=1
  527.     ~EVNT_TIMER(140)
  528.     ~WIND_CLOSE(awin)
  529.     ~WIND_DELETE(w2)
  530.     ~WIND_DELETE(w1)
  531.     ~MENU_BAR(rsc_me%,0)
  532.     IF gpl_de%>0
  533.       ~MFREE(gpl_de%)
  534.       ~MFREE(gpl_en%)
  535.     ENDIF
  536.     IF lin2%>0
  537.       ~MFREE(lin2%)
  538.     ENDIF
  539.     IF urt2%>0
  540.       ~MFREE(urt2%)
  541.     ENDIF
  542.     IF inf%>0
  543.       ~MFREE(inf%)
  544.     ENDIF
  545.     IF tao%>0
  546.       ~MFREE(tao%)
  547.     ENDIF
  548.     IF lin1%>0
  549.       ~MFREE(lin1%)
  550.     ENDIF
  551.     IF urt1%>0
  552.       ~MFREE(urt1%)
  553.     ENDIF
  554.     ~RSRC_FREE()
  555.     qui=1
  556.   ENDIF
  557. RETURN
  558. > PROCEDURE f              !ERROR
  559.   DEFTEXT txt_co,,,13
  560.   TEXT 512,353,t$(25)+" "+STR$(ERR)
  561.   w0
  562.   ON ERROR GOSUB f
  563.   RESUME f
  564. RETURN
  565. > PROCEDURE arb            !ARBEITSBEREICH
  566.   arb_br=wind(2)-2
  567.   arb_ho=wind(3)-wi_ti-1
  568. RETURN
  569. > PROCEDURE mima           !BALKEN
  570.   IF icon=0
  571.     SWAP wind(2),wind(4)
  572.     SWAP wind(3),wind(5)
  573.     mini=-mini+1
  574.     wmov
  575.   ENDIF
  576. RETURN
  577. > PROCEDURE icon(icn)      !ICON
  578.   IF mini=0
  579.     ~WIND_CLOSE(awin)
  580.     IF icon=0
  581.       IF icn<34
  582.         ~GRAF_SHRINKBOX(wind(6),wind(7),wind(8),wind(9),wind(0),wind(1),wind(2),wind(3))
  583.       ENDIF
  584.       awin=w2
  585.     ELSE
  586.       ~GRAF_GROWBOX(wind(0),wind(1),wind(2),wind(3),wind(6),wind(7),wind(8),wind(9))
  587.       awin=w1
  588.     ENDIF
  589.     SWAP wind(0),wind(6)
  590.     SWAP wind(1),wind(7)
  591.     SWAP wind(2),wind(8)
  592.     SWAP wind(3),wind(9)
  593.     IF icn=34 AND icon=0
  594.       wind(0)=m5
  595.       wind(1)=m6
  596.       wind(2)=m7
  597.       wind(3)=m8
  598.     ENDIF
  599.     arb
  600.     icon=-icon+1
  601.     opwin
  602.   ENDIF
  603. RETURN
  604. > PROCEDURE ttl            !FENSTERTITEL
  605.   IF icon=1
  606.     j$="I GING"
  607.     IF logo=1
  608.       j$="I CHING"
  609.     ENDIF
  610.     i$=j$+CHR$(0)+CHR$(0)
  611.   ELSE
  612.     i$=t$(0)+CHR$(0)+CHR$(0)
  613.   ENDIF
  614.   s%=V:i$
  615.   ~WIND_SET(awin,2,INT(SWAP(s%)),INT(s%),0,0)
  616. RETURN
  617. > PROCEDURE opwin          !FENSTER ÖFFNEN
  618.   ttl
  619.   ~WIND_OPEN(awin,wind(0),wind(1),wind(2),wind(3))
  620.   IF start=1
  621.     ~WIND_GET(awin,4,wx,by,wb,wh)
  622.     ~WIND_GET(awin,5,wx,wy,wb,wh)
  623.     wi_ti=by-wy
  624.     arb
  625.     IF wi_ti<>19
  626.       wind(3)=421+wi_ti
  627.       arb
  628.       wmov
  629.     ENDIF
  630.   ENDIF
  631.   clp
  632. RETURN
  633. > PROCEDURE wmov           !FENSTER BEWEGEN
  634.   ~WIND_SET(awin,5,wind(0),wind(1),wind(2),wind(3))
  635.   ttl
  636.   clp
  637. RETURN
  638. > PROCEDURE clp            !FENSTERCLIPPING
  639.   CLIP MAX(0,@offs_x),MAX(0,@offs_y),MIN(arb_br,@b),MIN(arb_ho,@h) OFFSET @offs_x,@offs_y
  640. RETURN
  641. '
  642. '            PROGRAMM-PROZEDUREN
  643. > PROCEDURE bmov(m%,m)     !TEXT IN TEXTBUFER
  644.   BMOVE m%,V:texte$,m*1000
  645. RETURN
  646. > PROCEDURE inp_txt(fv)    !TEXTSEITEN BLÄTTERN
  647.   w1
  648.   GRAPHMODE 2
  649.   IF fv=1
  650.     box3(co(9),co(8),1,231,394,320,420)
  651.     TEXT 245,399,t$(35)
  652.   ELSE
  653.     box3(co(9),co(8),1,321,394,410,420)
  654.     TEXT 333,399,t$(32)
  655.   ENDIF
  656.   GRAPHMODE 1
  657.   ~EVNT_TIMER(707)
  658.   w0
  659.   IF task=4
  660.     info=(info+fv*4) MOD 6+1
  661.   ELSE IF task=5
  662.     tao=(tao+fv*79) MOD 81+1
  663.   ELSE
  664.     sgpl=(sgpl+fv*(e_gp-2)) MOD e_gp+1
  665.   ENDIF
  666.   red_ne(0)
  667. RETURN
  668. > PROCEDURE as(f)          !START IGING
  669.   task=f
  670.   ~MENU_IENABLE(rsc_me%,21,0)
  671.   ~MENU_IENABLE(rsc_me%,23,0)
  672.   CLR wanco,wand7,again
  673.   icount=-1
  674.   red_ne(0)
  675. RETURN
  676. > PROCEDURE go             !WEITER IGING
  677.   IF icount<10
  678.     w1
  679.     GRAPHMODE 2
  680.     box3(co(9),co(8),1,492,394,638,420)
  681.     TEXT 511,399,t$(26)+"/[G]/[9]"
  682.     ~EVNT_TIMER(707)
  683.     box3(co(9),1,co(8),491,393,637,419)
  684.     TEXT 510,398,t$(26)+"/[G]/[9]"
  685.     GRAPHMODE 1
  686.     w0
  687.   ENDIF
  688.   INC icount
  689.   red_ne(0)
  690. RETURN
  691. > PROCEDURE infin          !START INFO
  692.   task=4
  693.   info=1
  694.   bmov(inf%,12)
  695.   red_ne(0)
  696. RETURN
  697. > PROCEDURE tao            !START TAO
  698.   IF tao<42
  699.     bmov(tao%,32)
  700.   ELSE
  701.     bmov(tao%+32000,32)
  702.   ENDIF
  703.   task=5
  704.   IF autao=0
  705.     red_ne(0)
  706.   ENDIF
  707. RETURN
  708. > PROCEDURE taoor          !TAO-ORAKEL
  709.   c=0
  710.   FOR f=1 TO 5
  711.     c=c+RANDOM(81)+1
  712.   NEXT f
  713.   tao=(c-1) MOD 81+1
  714.   tao
  715. RETURN
  716. > PROCEDURE gplin          !START GPL
  717.   task=6
  718.   sgpl=1
  719.   bmov(gpl%,26)
  720.   red_ne(0)
  721. RETURN
  722. > PROCEDURE osave          !ORAKEL SPEICHERN
  723.   IF again=1
  724.     INC oco
  725.     hex=line(13)
  726.     istt
  727.     w=INSTR(v,texte$,STR$(hex+2))
  728.     j$=CHR$(13)+CHR$(10)
  729.     h$=t$(36)+" "+datum$+"  "+zeit$+j$+j$+nam1$+j$+j$+MID$(texte$,v+1,w-v-1)+j$
  730.     bmov(line%+(hex DIV 32)*32000,32)
  731.     s=0
  732.     FOR f=1 TO 6
  733.       c=line(f+6)
  734.       IF c=6 OR c=9
  735.         IF f=6
  736.           h$=h$+t$(10)+STR$(c)+t$(14)+j$
  737.         ELSE IF f=1
  738.           h$=h$+t$(11)+STR$(c)+t$(14)+j$
  739.         ELSE
  740.           h$=h$+STR$(c)+t$(12)+STR$(f)+t$(13)+t$(14)+j$
  741.         ENDIF
  742.         r=hex*6+f
  743.         w=INSTR(texte$,STR$(r))+3
  744.         v=INSTR(w,texte$,STR$(r+1))
  745.         h$=h$+MID$(texte$,w,v-w)
  746.         INC s
  747.       ENDIF
  748.     NEXT f
  749.     IF s>0
  750.       hex=line(14)
  751.       istt
  752.       w=INSTR(v,texte$,STR$(hex+2))
  753.       h$=h$+j$+t$(6)+j$+j$+nam$+j$+MID$(texte$,v+1,w-v-1)
  754.     ELSE
  755.       h$=h$+t$(7)+j$
  756.     ENDIF
  757.     h$=h$+j$+"<eof>"+j$
  758.     c$="I"+LEFT$(datum$,2)+MID$(datum$,4,2)+RIGHT$(datum$,2)+CHR$(oco+64)+".TXT"
  759.     IF osa$=""
  760.       osa$=pfad$
  761.       IF EXIST(pfad$+"ORAKEL\*.*")<>0
  762.         osa$=osa$+"ORAKEL\"
  763.       ENDIF
  764.     ENDIF
  765.     ttl
  766.     f$=@fsel$(t$(37),osa$+"*.TXT",c$)
  767.     ttl
  768.     IF f$<>""
  769.       OPEN "O",#2,f$
  770.       BPUT #2,V:h$,LEN(h$)
  771.       CLOSE #2
  772.     ENDIF
  773.     CLR j$,c$,h$,a$,f$
  774.   ENDIF
  775. RETURN
  776. > FUNCTION fsel$(a$,f$,c$) !FILESELECT1
  777. IF INT{ADD({ADD(GB,4)},0)}<&H140
  778.   ro=FSEL_INPUT(f$,c$,f)
  779. ELSE
  780.   ro=@fsel_ex(a$,f$,c$,f)
  781. ENDIF
  782. IF f=0 OR ro=0 OR c$=""
  783.   RETURN ""
  784. ENDIF
  785. FOR r=0 TO 9
  786.   EXIT IF MID$(f$,LEN(f$)-r,1)="\"
  787. NEXT r
  788. osa$=LEFT$(f$,LEN(f$)-r)
  789. RETURN osa$+c$
  790. ENDFUNC
  791. > FUNCTION fsel_ex(a$,VAR f$,c$,f)    !FILESELECT2
  792. a$=a$+CHR$(0)
  793. f$=f$+CHR$(0)+SPACE$(400)
  794. c$=c$+CHR$(0)+SPACE$(150)
  795. GCONTRL(0)=91
  796. GCONTRL(1)=0
  797. GCONTRL(2)=2
  798. GCONTRL(3)=3
  799. GCONTRL(4)=0
  800. ADDRIN(0)=V:f$
  801. ADDRIN(1)=V:c$
  802. ADDRIN(2)=V:a$
  803. GEMSYS
  804. f$=CHAR{V:f$}
  805. c$=CHAR{V:c$}
  806. f=GINTOUT(1)
  807. RETURN GINTOUT(0)
  808. ENDFUNC
  809. '
  810. '            DIE REDRAW-PROZEDUREN
  811. > PROCEDURE red_ne(z)      !PROGRAMM-REDRAW
  812. red(@offs_x,@offs_y,arb_br,arb_ho,z)
  813. RETURN
  814. > PROCEDURE red(rx,ry,rb,rh,evnt)           !REDRAW
  815. ttl
  816. IF mini=0
  817. w1
  818. ~WIND_GET(awin,11,wx,wy,wb,wh)
  819. WHILE wb+wh<>0
  820.   wb=wx+wb
  821.   wh=wy+wh
  822.   wx=MAX(wx,rx)
  823.   wy=MAX(wy,ry)
  824.   wb=MIN(wb,rx+rb)-wx
  825.   wh=MIN(wh,ry+rh)-wy
  826.   IF wb>0 AND wh>0
  827.     IF RC_INTERSECT(rx,ry,rb,rh,wx,wy,wb,wh)
  828.       CLIP wx,wy,MIN(wb,@b),MIN(wh,@h) OFFSET @offs_x,@offs_y
  829.       IF icon=0
  830.         ON task+1 GOSUB tibi,start,iging,iging,info,taote,gpl
  831.       ELSE
  832.         box3(co(9),1,co(8),0,0,arb_br-1,arb_ho-1)
  833.         box3(co(9),-co(8),1,6,6,arb_br-7,arb_ho-7)
  834.         DEFFILL 1
  835.         j%=V:yiya$
  836.         FOR y=0 TO 15
  837.           o%=CARD{j%+y*2}
  838.           FOR x=0 TO 15
  839.             IF BTST(o%,-x+15)=0
  840.               PBOX x*2+19,y*2+10,x*2+20,y*2+11
  841.             ENDIF
  842.           NEXT x
  843.         NEXT y
  844.       ENDIF
  845.     ENDIF
  846.   ENDIF
  847.   ~WIND_GET(awin,12,wx,wy,wb,wh)
  848. WEND
  849. w0
  850. ~WIND_GET(awin,4,wx,wy,wb,wh)
  851. clp
  852. ENDIF
  853. RETURN
  854. > PROCEDURE tibi           !TITELBILD
  855. box3(co(9),1,co(8),0,0,637,419)
  856. box3(co(9),-co(8),1,42,42,595,377)
  857. clbox(1,co(8),43,43,596,376)
  858. box3(co(9),1,co(8),108,50,529,91)
  859. box3(co(9),1,co(8),145,329,492,371)
  860. GRAPHMODE 2
  861. DEFTEXT co(12),,,26
  862. i$=t$(3)+" "+t$(4)
  863. TEXT (400-(LEN(i$)*16)) DIV 2+119,55,i$
  864. DEFTEXT txt_co,,,13
  865. TEXT 155,335,"V 3.3.2    GFA 3.6TT    5/0"
  866. TEXT 420,335,"by ZWYRD"
  867. TEXT 155,351,"Released under GNU General Public License"
  868. GRAPHMODE 1
  869. IF logo=0
  870. logo
  871. ELSE
  872. logo2
  873. ENDIF
  874. RETURN
  875. > PROCEDURE start          !STARTSEITE
  876. lard
  877. z=INSTR(1,texte$,"1.")-1
  878. txt(1,2,30,z)
  879. RETURN
  880. > PROCEDURE iging
  881. IF icount<11
  882. IF icount=-1 OR evnt>0
  883.   box3(co(9),1,co(8),0,0,637,392)
  884.   box3(co(9),1,co(8),0,393,490,419)
  885.   box3(co(9),1,co(8),491,393,637,419)
  886.   RESTORE t
  887.   IF task=3
  888.     box3(co(10),-1,co(8),3,123,51,162)
  889.     GRAPHMODE 2
  890.     DEFTEXT co(9),,,13
  891.     TEXT 16,135,"(R)"
  892.     GRAPHMODE 1
  893.   ENDIF
  894.   FOR r=75 TO 472 STEP 397
  895.     box3(co(9),-co(8),1,r-20,123,r+110,264)
  896.     FOR w=1 TO 2
  897.       FOR v=1 TO 8
  898.         READ s
  899.         DEFFILL txt_co
  900.         PBOX r,138+s,r+10,140+s
  901.         IF w=1
  902.           DEFFILL @bp(co(9))
  903.           PBOX r+4,138+s,r+6,140+s
  904.         ENDIF
  905.         EXIT IF v=4 AND OR(r=75 AND w=2,r=472 AND w=1)
  906.       NEXT v
  907.     NEXT w
  908.     DEFTEXT txt_co,,,13
  909.     GRAPHMODE 2
  910.     FOR v=1 TO 4
  911.       TEXT r+20,97+v*32,t$((r DIV 400)*5+39+v)
  912.       TEXT r+20,113+v*32,t$((r DIV 400)*5+49+v)
  913.     NEXT v
  914.     GRAPHMODE 1
  915.   NEXT r
  916. ENDIF
  917. IF icount<>7 OR wand7>0
  918.   kern
  919. ELSE
  920.   INC icount
  921. ENDIF
  922. IF icount=8
  923.   IF wanco>0
  924.     INC icount
  925.     kern
  926.   ELSE
  927.     wech
  928.     GRAPHMODE 2
  929.     TEXT 256,33,t$(7)
  930.     GRAPHMODE 1
  931.     ADD icount,2
  932.   ENDIF
  933. ENDIF
  934. ELSE IF icount=11
  935. lard
  936. GRAPHMODE 2
  937. DEFTEXT co(10),4,,26
  938. TEXT 60,32,t$(15)
  939. TEXT 100,82,t$(16)
  940. DEFTEXT co(11),0
  941. TEXT 100,132,t$(17)
  942. TEXT 90,182,t$(20)
  943. TEXT 80,232,t$(21)
  944. TEXT 51,282,t$(22)
  945. DEFTEXT co(14)
  946. TEXT 240,332,"KALLISTI"
  947. GRAPHMODE 1
  948. ~MENU_IENABLE(rsc_me%,21,1)
  949. ~MENU_IENABLE(rsc_me%,23,1)
  950. again=1
  951. IF auigg_ex=1
  952.   auex=1
  953. ENDIF
  954. ELSE
  955. CLR task
  956. red_ne(0)
  957. ENDIF
  958. RETURN
  959. > PROCEDURE info
  960. txt_in(info)
  961. TEXT 80,398,"INFO"
  962. TEXT 569,5,"FRE:"+STR$(l%)
  963. txt(t(info-1)+2,1,25,t(info))
  964. RETURN
  965. > PROCEDURE taote
  966. IF tao=1 OR tao=41
  967. bmov(tao%,32)
  968. ELSE IF tao=42 OR tao=81
  969. bmov(tao%+32000,32)
  970. ENDIF
  971. txt_in(tao)
  972. TEXT 50,398,t$(30)
  973. TEXT 162,398,t$(31)+" "+STR$(tao)
  974. TEXT 424,398,t$(33)+" "+t$(34)
  975. w=INSTR(texte$,STR$(tao))
  976. v=INSTR(w,texte$,STR$(tao+1))
  977. txt(w,1,25,v)
  978. IF autao_ex=1
  979. auex=1
  980. ENDIF
  981. RETURN
  982. > PROCEDURE gpl
  983. txt_in(sgpl)
  984. TEXT 80,398,"GPL"
  985. CLR f,w
  986. lgpl=1
  987. v=INSTR(texte$,"<eof>")
  988. WHILE f<(sgpl-1)*24
  989. lgpl=INSTR(w,texte$,CHR$(13))
  990. EXIT IF lgpl=0 OR lgpl>v
  991. w=lgpl+2
  992. INC f
  993. WEND
  994. IF lgpl>0
  995. IF lgpl=1
  996.   lgpl=0
  997. ELSE
  998.   ADD lgpl,2
  999. ENDIF
  1000. txt(lgpl,1,24,v)
  1001. ENDIF
  1002. RETURN
  1003. '
  1004. '            DIE I GING-PROZEDUREN
  1005. > PROCEDURE line           !LINIENGRAFIK
  1006. SELECT line(linco)
  1007. CASE 6
  1008. box3(co(10),-1,co(8),240,hex_y,294,hex_y+16)
  1009. box3(co(10),-1,co(8),344,hex_y,398,hex_y+16)
  1010. ellip(co(11),co(8),1,319,hex_y+8,12,9)
  1011. CASE 7
  1012. box3(txt_co,-co(8),co(9),240,hex_y,398,hex_y+16)
  1013. CASE 8
  1014. box3(txt_co,-co(8),co(9),240,hex_y,294,hex_y+16)
  1015. box3(txt_co,-co(8),co(9),344,hex_y,398,hex_y+16)
  1016. CASE 9
  1017. box3(co(10),-1,co(8),240,hex_y,398,hex_y+16)
  1018. ellip(co(11),co(8),1,319,hex_y+8,12,9)
  1019. ENDSELECT
  1020. RETURN
  1021. > PROCEDURE punkt          !DER LAUFENDE PUNKT
  1022. GRAPHMODE 2
  1023. n=@bp(co(9))
  1024. FOR v=240 TO 320 STEP 10
  1025. FOR w=co(11) TO n STEP -(co(11)-n)
  1026.   DEFFILL w
  1027.   PCIRCLE v,hex_y+8,10
  1028.   PCIRCLE 640-v,hex_y+8,10
  1029.   ~EVNT_TIMER(23)
  1030. NEXT w
  1031. NEXT v
  1032. GRAPHMODE 1
  1033. RETURN
  1034. > PROCEDURE wech           !LINIENTEXTE LÖSCHEN
  1035. IF evnt<2
  1036. DEFFILL co(10)
  1037. IF EVEN(line(MIN(5,icount-1)))
  1038.   box3(co(10),-co(8),1,4,4,214,82)
  1039.   box3(co(10),-co(8),1,425,4,633,82)
  1040. ELSE
  1041.   box3(co(10),-co(8),1,4,4,633,82)
  1042. ENDIF
  1043. DEFFILL co(11)
  1044. ellip(co(11),1,co(8),319,41,37,37)
  1045. ~EVNT_TIMER(410)
  1046. DEFFILL @bp(co(9))
  1047. PBOX 4,4,633,82
  1048. ENDIF
  1049. RETURN
  1050. > PROCEDURE alt            !ORAKEL STENGEL-A
  1051. CLR x,y,n,z
  1052. FOR s=0 TO 2
  1053. punkt
  1054. r=x+y+z
  1055. x=RANDOM(47-r)+2
  1056. y=49-r-x
  1057. DEC x
  1058. WHILE y>4
  1059.   SUB y,4
  1060. WEND
  1061. WHILE x>4
  1062.   SUB x,4
  1063. WEND
  1064. IF s=1
  1065.   n=1
  1066.   z=r
  1067. ENDIF
  1068. IF x+y+n=8
  1069.   ADD line(linco),2
  1070. ELSE
  1071.   ADD line(linco),3
  1072. ENDIF
  1073. INC x
  1074. NEXT s
  1075. RETURN
  1076. > PROCEDURE zwy            !ORAKEL STENGEL-Z
  1077. FOR s=0 TO 2
  1078. punkt
  1079. r=RANDOM(4)
  1080. IF (s=0 AND r<3) OR (s>0 AND r<2)
  1081.   ADD line(linco),3
  1082. ELSE
  1083.   ADD line(linco),2
  1084. ENDIF
  1085. NEXT s
  1086. RETURN
  1087. > PROCEDURE muen           !ORAKEL MÜNZEN
  1088. punkt
  1089. line(linco)=RANDOM(2)+2
  1090. ADD line(linco),RANDOM(2)+2
  1091. ADD line(linco),RANDOM(2)+2
  1092. RETURN
  1093. > PROCEDURE ran            !ORAKEL EASY
  1094. punkt
  1095. line(linco)=RANDOM(4)+6
  1096. ' line(linco)=6
  1097. RETURN
  1098. > PROCEDURE kern           !DAS EIGENTLICHE I GING
  1099. IF icount=9
  1100. DEFFILL @bp(co(9))
  1101. PBOX 3,270,634,387
  1102. PBOX 3,83,634,114
  1103. wech
  1104. GRAPHMODE 2
  1105. TEXT 264,33,t$(6)
  1106. GRAPHMODE 1
  1107. ENDIF
  1108. IF task=3 AND (icount=-1 OR icount=9)
  1109. INC icount
  1110. FOR f=0 TO 5
  1111.   SWAP line(f),line(f+7)
  1112. NEXT f
  1113. hex=line(icount DIV 9+13)
  1114. DEFFILL @bp(co(9))
  1115. PBOX 240,122,398,265
  1116. ENDIF
  1117. linco=0
  1118. FOR hex_y=248 TO 123 STEP -25
  1119. IF wanco=0
  1120.   IF icount=-1
  1121.     ON orakel GOSUB alt,zwy,muen,ran
  1122.     line(linco+7)=line(linco)
  1123.     IF ODD(line(linco))
  1124.       logli(linco)=2^linco
  1125.     ELSE
  1126.       logli(linco)=2^(linco+6)
  1127.     ENDIF
  1128.     IF linco=5
  1129.       INC icount
  1130.     ENDIF
  1131.   ENDIF
  1132.   IF icount<1 OR evnt>0
  1133.     line
  1134.   ENDIF
  1135. ELSE
  1136.   IF icount=9
  1137.     IF line(linco)=6 OR line(linco)=9
  1138.       punkt
  1139.       IF line(linco)=6
  1140.         line(linco)=7
  1141.         logli(linco)=2^linco
  1142.       ELSE
  1143.         line(linco)=8
  1144.         logli(linco)=2^(linco+6)
  1145.       ENDIF
  1146.       line
  1147.     ENDIF
  1148.     IF linco=5
  1149.       INC icount
  1150.     ENDIF
  1151.   ELSE
  1152.     IF evnt>0 OR task=3
  1153.       line
  1154.     ENDIF
  1155.   ENDIF
  1156. ENDIF
  1157. INC linco
  1158. NEXT hex_y
  1159. IF (icount=0 OR icount=10) AND task=2
  1160. RESTORE m
  1161. FOR hex=0 TO 63
  1162.   READ f
  1163.   EXIT IF f=logli(1)+logli(2)+logli(3)+logli(4)+logli(5)+logli(0)
  1164. NEXT hex
  1165. line(icount DIV 9+13)=hex
  1166. ENDIF
  1167. IF icount=0 OR icount=10 OR evnt>0
  1168. istt
  1169. nam$=MID$(texte$,w,v-w-2)
  1170. IF icount=0
  1171.   nam1$=nam$
  1172.   datum$=DATE$
  1173.   zeit$=TIME$
  1174. ENDIF
  1175. GRAPHMODE 2
  1176. DEFTEXT co(14),,,26
  1177. TEXT (608-(v-w-2)*15)/2,83,nam$
  1178. GRAPHMODE 1
  1179. DEFTEXT txt_co,,,13
  1180. w=INSTR(v,texte$,STR$(hex+2))
  1181. txt(v+1,18,25,w)
  1182. ENDIF
  1183. IF icount>0 AND icount<8
  1184. WHILE line(icount-1)=8 OR line(icount-1)=7
  1185.   INC icount
  1186. WEND
  1187. IF line(icount-1)=9 OR line(icount-1)=6
  1188.   wech
  1189.   bmov(line%+(hex DIV 32)*32000,32)
  1190.   INC wanco
  1191.   GRAPHMODE 2
  1192.   IF icount=6
  1193.     TEXT 216,3,t$(10)+STR$(line(icount-1))+t$(14)
  1194.   ELSE IF icount=1
  1195.     TEXT 216,3,t$(11)+STR$(line(icount-1))+t$(14)
  1196.   ELSE
  1197.     TEXT 216,3,STR$(line(icount-1))+t$(12)+STR$(icount)+t$(13)+t$(14)
  1198.   ENDIF
  1199.   GRAPHMODE 2
  1200.   r=hex*6+icount
  1201.   w=INSTR(texte$,STR$(r))+3
  1202.   v=INSTR(w,texte$,STR$(r+1))
  1203.   txt(w,2,6,v)
  1204.   IF AND(r=6 OR r=12,wanco=6)
  1205.     wand7=r
  1206.   ENDIF
  1207. ENDIF
  1208. IF icount=7
  1209.   IF wand7>5
  1210.     wech
  1211.     bmov(line%,32)
  1212.     w=INSTR(texte$,STR$(wand7+200))+3
  1213.     v=INSTR(w,texte$,STR$(wand7+201))
  1214.     txt(w,2,6,v)
  1215.     wand7=0
  1216.   ELSE
  1217.     INC icount
  1218.   ENDIF
  1219. ENDIF
  1220. ENDIF
  1221. IF icount=0 OR evnt>0
  1222. GRAPHMODE 2
  1223. TEXT 10,398,nam1$
  1224. wco=0
  1225. IF icount>9
  1226.   wco=7
  1227. ENDIF
  1228. FOR f=0 TO 5
  1229.   EXIT IF line(f+wco)=6 OR line(f+wco)=9
  1230. NEXT f
  1231. IF f=6
  1232.   TEXT 350,398,t$(7)
  1233. ELSE
  1234.   TEXT 350,398,"~             ~"
  1235.   FOR f=0 TO 5
  1236.     IF line(f+wco)=6 OR line(f+wco)=9
  1237.       TEXT 366+f*16,398,f+1
  1238.     ENDIF
  1239.   NEXT f
  1240. ENDIF
  1241. TEXT 510,398,t$(26)+"/[G]/[9]"
  1242. GRAPHMODE 1
  1243. ENDIF
  1244. RETURN
  1245. > PROCEDURE istt           !ZEICHENSUCHE
  1246. bmov(urteil%,32)
  1247. z=INSTR(1,texte$,"1.")-1
  1248. w=INSTR(z,texte$,STR$(hex+1))
  1249. v=INSTR(w+2,texte$,"0")
  1250. RETURN
  1251. '
  1252. '            GRAFIK-PROZEDUREN
  1253. > FUNCTION bp(n)           ! S/W-box?
  1254. IF bitpl=1 AND (n=co(8) OR n=co(9))
  1255. RETURN 0
  1256. ENDIF
  1257. RETURN n
  1258. ENDFUNC
  1259. > FUNCTION lp(n)           ! S/W-line?
  1260. IF bitpl=1
  1261. RETURN 1
  1262. ENDIF
  1263. RETURN n
  1264. ENDFUNC
  1265. > PROCEDURE box3(b1,b2,b3,bx,by,bv,bw)
  1266. DEFFILL @bp(b1)
  1267. IF b2<0
  1268. PBOX bx+2,by+2,bv-2,bw-2
  1269. ELSE
  1270. PBOX bx,by,bv,bw
  1271. ENDIF
  1272. clbox(b3,ABS(b2),bx,by,bv,bw)
  1273. RETURN
  1274. > PROCEDURE clbox(b3,b2,bx,by,bv,bw)
  1275. COLOR @lp(b3)
  1276. DRAW bx+2,bw-3 TO bx+2,bw-4 TO bx+1,bw-4 TO bx+1,by+4 TO bx+2,by+4 TO bx+2,by+2
  1277. DRAW  TO bx+4,by+2 TO bx+4,by+1 TO bv-4,by+1 TO bv-4,by+2 TO bv-3,by+2
  1278. COLOR @lp(b2)
  1279. DRAW bx+3,bw-2 TO bx+4,bw-2 TO bx+4,bw-1 TO bv-4,bw-1 TO bv-4,bw-2 TO bv-2,bw-2
  1280. DRAW  TO bv-2,bw-4 TO bv-1,bw-4 TO bv-1,by+4 TO bv-2,by+4 TO bv-2,by+3
  1281. RETURN
  1282. > PROCEDURE ellip(b1,b2,b3,bx,by,bv,bw)
  1283. DEFFILL b1
  1284. PELLIPSE bx,by,bv-1,bw-1
  1285. COLOR b2
  1286. ELLIPSE bx,by,bv,bw,450,2250
  1287. COLOR b3
  1288. ELLIPSE bx,by,bv,bw,2250,450
  1289. RETURN
  1290. > PROCEDURE logo2          !TITELBILD - I Ching
  1291. ellip(co(14),co(8),1,352,135,13,10)
  1292. ' I
  1293. box3(co(10),-1,co(8),69,109,100,261)
  1294. ' C
  1295. box3(co(10),-1,co(8),141,109,173,261)
  1296. box3(co(10),-1,co(8),166,109,228,141)
  1297. PBOX 166,111,171,141
  1298. box3(co(10),-1,co(8),166,224,228,261)
  1299. PBOX 166,224,171,259
  1300. ' h
  1301. box3(co(10),-1,co(8),236,109,268,261)
  1302. box3(co(10),-1,co(8),266,159,304,191)
  1303. PBOX 266,165,268,188
  1304. box3(co(10),-1,co(8),296,159,328,261)
  1305. PBOX 296,161,300,189
  1306. ' i
  1307. box3(co(10),-1,co(8),336,159,368,261)
  1308. ' n
  1309. box3(co(10),-1,co(8),376,159,408,261)
  1310. box3(co(10),-1,co(8),406,159,444,191)
  1311. PBOX 406,165,408,188
  1312. box3(co(10),-1,co(8),436,159,468,261)
  1313. PBOX 436,161,440,189
  1314. ' g
  1315. box3(co(10),-1,co(8),476,159,568,261)
  1316. box3(co(9),-co(8),1,506,189,538,226)
  1317. box3(co(10),-1,co(8),69,289,568,321)
  1318. box3(co(10),-1,co(8),536,254,568,296)
  1319. PBOX 536,253,566,259
  1320. PBOX 536,291,566,297
  1321. RETURN
  1322. > PROCEDURE logo           !TITELBILD
  1323. ellip(co(14),co(8),1,315,135,13,10)
  1324. ' I
  1325. box3(co(10),-1,co(8),86,109,117,261)
  1326. '
  1327. ' G
  1328. box3(co(10),-1,co(8),189,109,221,261)
  1329. box3(co(10),-1,co(8),214,109,266,141)
  1330. PBOX 214,111,219,141
  1331. box3(co(10),-1,co(8),214,224,281,261)
  1332. PBOX 214,224,219,259
  1333. box3(co(10),-1,co(8),249,179,281,231)
  1334. PBOX 249,226,279,232
  1335. box3(co(10),-1,co(8),239,179,256,211)
  1336. PBOX 251,181,256,212
  1337. ' i
  1338. box3(co(10),-1,co(8),299,159,331,261)
  1339. ' n
  1340. box3(co(10),-1,co(8),349,159,381,261)
  1341. box3(co(10),-1,co(8),379,159,417,191)
  1342. PBOX 379,165,381,188
  1343. box3(co(10),-1,co(8),409,159,441,261)
  1344. PBOX 409,161,413,189
  1345. ' g
  1346. box3(co(10),-1,co(8),459,159,551,261)
  1347. box3(co(9),-co(8),1,489,189,521,226)
  1348. box3(co(10),-1,co(8),86,289,551,321)
  1349. box3(co(10),-1,co(8),519,254,551,296)
  1350. PBOX 519,253,549,259
  1351. PBOX 519,291,549,297
  1352. RETURN
  1353. > PROCEDURE lard           !EIN WENIG KITSCH
  1354. box3(co(9),1,co(8),0,0,637,419)
  1355. DEFFILL ,2,5
  1356. box3(1,-co(8),1,6,8,36,411)
  1357. box3(1,-co(8),1,601,8,631,411)
  1358. DEFFILL ,1,0
  1359. box3(co(9),-co(8),1,46,8,591,411)
  1360. RETURN
  1361. > PROCEDURE txt_in(fx)     !GRAFIK DER TEXTSEITEN
  1362. box3(co(9),1,co(8),0,0,637,392)
  1363. DEFTEXT txt_co,,,26
  1364. GRAPHMODE 2
  1365. TEXT 590,20,fx
  1366. box3(co(9),1,co(8),230,393,319,419)
  1367. box3(co(9),1,co(8),320,393,409,419)
  1368. DEFTEXT ,,,13
  1369. TEXT 244,398,t$(35)
  1370. TEXT 332,398,t$(32)
  1371. box3(co(9),1,co(8),0,393,229,419)
  1372. box3(co(9),1,co(8),410,393,637,419)
  1373. RETURN
  1374. > PROCEDURE txt(d,x,y,n)   !TEXTAUSGABE
  1375. DEFTEXT txt_co,,,13
  1376. GRAPHMODE 2
  1377. FOR f=x TO y
  1378. c=INSTR(d,texte$,CHR$(13))
  1379. EXIT IF c=0 OR c>n
  1380. TEXT 5,f*16-13,MID$(texte$,d,c-d)
  1381. d=c+2
  1382. NEXT f
  1383. GRAPHMODE 1
  1384. RETURN
  1385. '
  1386. '            MEHR SYSTEM-PROZEDUREN
  1387. > PROCEDURE txcha(f)       !MENU TEXTE ÄNDERN
  1388. ~MENU_IENABLE(rsc_me%,f,0)
  1389. text2=-(f-33)+34
  1390. ~MENU_IENABLE(rsc_me%,text2,1)
  1391. IF f=33
  1392. urteil%=urt1%
  1393. line%=lin1%
  1394. ELSE
  1395. urteil%=urt2%
  1396. IF nixlin2=0
  1397. line%=lin2%
  1398. ENDIF
  1399. ENDIF
  1400. RETURN
  1401. > PROCEDURE orcha(f)       !MENU ORAKEL ÄNDERN
  1402. ~MENU_ICHECK(rsc_me%,orakel+35,0)
  1403. ~MENU_ICHECK(rsc_me%,f,1)
  1404. orakel=f-35
  1405. RETURN
  1406. > PROCEDURE mncha(c)       !MENU-SPRACHE TAUSCHEN
  1407. IF c=1
  1408. ~MENU_ICHECK(rsc_me%,orakel+35,0)
  1409. ~MENU_BAR(rsc_me%,0)
  1410. menlan=-menlan+1
  1411. ENDIF
  1412. IF menlan=0
  1413. rsc_me%=men_1%
  1414. rsc_ve%=ver_1%
  1415. rsc_en%=end_1%
  1416. gpl%=gpl_de%
  1417. e_gp=19
  1418. ELSE
  1419. rsc_me%=men_2%
  1420. rsc_ve%=ver_2%
  1421. rsc_en%=end_2%
  1422. gpl%=gpl_en%
  1423. e_gp=14
  1424. ENDIF
  1425. ~MENU_BAR(rsc_me%,1)
  1426. ~MENU_ICHECK(rsc_me%,orakel+35,1)
  1427. ~MENU_IENABLE(rsc_me%,-(text2-33)+34,0)
  1428. IF again=0
  1429. ~MENU_IENABLE(rsc_me%,21,0)
  1430. ~MENU_IENABLE(rsc_me%,23,0)
  1431. ENDIF
  1432. IF nixtao=1
  1433. ~MENU_IENABLE(rsc_me%,30,0)
  1434. ~MENU_IENABLE(rsc_me%,31,0)
  1435. ENDIF
  1436. IF nixinfo=1
  1437. ~MENU_IENABLE(rsc_me%,27,0)
  1438. ENDIF
  1439. IF nixtxt2=1
  1440. ~MENU_IENABLE(rsc_me%,34,0)
  1441. ELSE
  1442. ~MENU_IENABLE(rsc_me%,text2,1)
  1443. ENDIF
  1444. IF nixgpl=1
  1445. ~MENU_IENABLE(rsc_me%,28,0)
  1446. ENDIF
  1447. IF task=6
  1448. sgpl=1
  1449. bmov(gpl%,26)
  1450. ENDIF
  1451. IF c=1 OR (start=1 AND menlan=1)
  1452. SWAP t$(),r$()
  1453. IF c=1
  1454. red_ne(1)
  1455. ENDIF
  1456. ENDIF
  1457. RETURN
  1458. > PROCEDURE chaco          !HINTERGRUND TAUSCHEN
  1459. SWAP co(8),co(9)
  1460. red_ne(1)
  1461. RETURN
  1462. > PROCEDURE kan            !FARBKANÄLE ROTIEREN
  1463. FOR f=2 TO 15
  1464. co(f)=(co(f)-1) MOD 14+2
  1465. NEXT f
  1466. red_ne(1)
  1467. RETURN
  1468. > PROCEDURE logch          !LOGO TAUSCHEN
  1469. logo=-logo+1
  1470. IF task=0
  1471. red_ne(1)
  1472. ENDIF
  1473. RETURN
  1474. > PROCEDURE w1
  1475. ~WIND_UPDATE(1)
  1476. RETURN
  1477. > PROCEDURE w0
  1478. ~WIND_UPDATE(0)
  1479. RETURN
  1480. > PROCEDURE form(o%)       !RSC-FORMULARE
  1481. ttl
  1482. ~FORM_CENTER(o%,fx,fy,fb,fh)
  1483. ~OBJC_DRAW(o%,0,2,fx,fy,fb,fh)
  1484. ~FORM_DIAL(0,0,0,0,0,fx,fy,fb,fh)
  1485. ro=FORM_DO(o%,0)
  1486. ~FORM_DIAL(3,0,0,0,0,fx,fy,fb,fh)
  1487. ~OBJC_CHANGE(o%,ro,0,fx,fy,fb,fh,0,0)
  1488. ttl
  1489. ' button: version=2,ende=3+4
  1490. RETURN
  1491. > FUNCTION fre             !FREIER SPEICHER
  1492. IF a_st<>0
  1493. RETURN MALLOC(-1)
  1494. ENDIF
  1495. fb%=GEMDOS(68,L:-1,0)
  1496. fm%=GEMDOS(68,L:-1,1)
  1497. RETURN MAX(fm%,fb%)
  1498. ENDFUNC
  1499. > FUNCTION mal(j%)         !SPEICHER ALLOZIEREN
  1500. IF a_st<>0
  1501. RETURN MALLOC(j%)
  1502. ENDIF
  1503. RETURN GEMDOS(68,L:j%,3)
  1504. ENDFUNC
  1505.